/// <reference path="references.js" />

// -------------------------------------------------
// Error
// -------------------------------------------------

//-----------------------------------------------------------------------------
//-- |
//-- Module      :  Text.Parsec.Error
//-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
//-- License     :  BSD-style (see the LICENSE file)
//-- 
//-- Maintainer  :  derek.a.elkins@gmail.com
//-- Stability   :  provisional
//-- Portability :  portable
//-- 
//-- Parse errors
//-- 
//-----------------------------------------------------------------------------
//
//module Text.Parsec.Error
//    ( Message ( SysUnExpect, UnExpect, Expect, Message )
//    , messageString
//    , ParseError, errorPos, errorMessages, errorIsUnknown
//    , showErrorMessages
//    , newErrorMessage, newErrorUnknown
//    , addErrorMessage, setErrorPos, setErrorMessage
//    , mergeError
//    ) where
//
//import Data.List ( nub, sort )
//
//import Text.Parsec.Pos
//
//-- | This abstract data type represents parse error messages. There are
//-- four kinds of messages:
//--
//-- >  data Message = SysUnExpect String
//-- >               | UnExpect String
//-- >               | Expect String
//-- >               | Message String
//-- 
//-- The fine distinction between different kinds of parse errors allows
//-- the system to generate quite good error messages for the user. It
//-- also allows error messages that are formatted in different
//-- languages. Each kind of message is generated by different combinators:
//--
//--     * A 'SysUnExpect' message is automatically generated by the
//--       'Text.Parsec.Combinator.satisfy' combinator. The argument is the
//--       unexpected input.
//--
//--     * A 'UnExpect' message is generated by the 'Text.Parsec.Prim.unexpected'
//--       combinator. The argument describes the
//--       unexpected item.
//--
//--     * A 'Expect' message is generated by the 'Text.Parsec.Prim.<?>'
//--       combinator. The argument describes the expected item.
//--
//--     * A 'Message' message is generated by the 'fail'
//--       combinator. The argument is some general parser message. 
//
//data Message = SysUnExpect !String -- @ library generated unexpect
//             | UnExpect    !String -- @ unexpected something
//             | Expect      !String -- @ expecting something
//             | Message     !String -- @ raw message

function Message(){}
data(Message, [["SysUnExpect", String]
              ,["UnExpect", String]
              ,["Expect", String]
              ,["Message", String]
              ]);

//instance Enum Message where
//    fromEnum (SysUnExpect _) = 0
//    fromEnum (UnExpect    _) = 1
//    fromEnum (Expect      _) = 2
//    fromEnum (Message     _) = 3
//    toEnum _ = error "toEnum is undefined for Message"
//
//-- < Return 'True' only when 'compare' would return 'EQ'.



instance(Enum, Message)
    ("toEnum", function(_){ error("toEnum is undefined for Message"); })
    ("fromEnum", function(msg){
      return msg.SysUnExpect ? 0 :
             msg.UnExpect    ? 1 :
             msg.Expect      ? 2 :
             msg.Message     ? 3 :
             error("fromEnum");
    })

//instance Eq Message where
//    m1 == m2 = fromEnum m1 == fromEnum m2

instance(Eq, Message)
    ("eq", function(m1, m2){ return Enum.fromEnum(m1) === Enum.fromEnum(m2) })

//-- < Compares two error messages without looking at their content. Only
//-- the constructors are compared where:
//-- 
//-- > 'SysUnExpect' < 'UnExpect' < 'Expect' < 'Message'
//
//instance Ord Message where
//    compare msg1 msg2 = compare (fromEnum msg1) (fromEnum msg2)
instance(Ord, Message)
    ("compare", function(msg1, msg2){
        return Ord.compare(Enum.fromEnum(msg1), Enum.fromEnum(msg2));
    })
    
//-- | Extract the message string from an error message 
//
//messageString :: Message -> String
//messageString (SysUnExpect s) = s
//messageString (UnExpect    s) = s
//messageString (Expect      s) = s
//messageString (Message     s) = s
function messageString(msg){
    return msg[0];
}

//-- | The abstract data type @ParseError@ represents parse errors. It
//-- provides the source position ('SourcePos') of the error
//-- and a list of error messages ('Message'). A @ParseError@
//-- can be returned by the function 'Text.Parsec.Prim.parse'. @ParseError@ is an
//-- instance of the 'Show' class. 
//
//data ParseError = ParseError !SourcePos [Message]

function ParseError(){}
data(ParseError, [["ParseError", SourcePos, Array]]);


//-- | Extracts the source position from the parse error
//
//errorPos :: ParseError -> SourcePos
//errorPos (ParseError pos _msgs)
//    = pos
function errorPos(parseError){
    return parseError[0];
}

//-- | Extracts the list of error messages from the parse error
//
//errorMessages :: ParseError -> [Message]
//errorMessages (ParseError _pos msgs)
//    = sort msgs
function errorMessages(parseError){
    return sort(parseError[1]);
}

//errorIsUnknown :: ParseError -> Bool
//errorIsUnknown (ParseError _pos msgs)
//    = null msgs
function errorIsUnknown(parseError){
    return null_(parseError[1]);
}

//-- < Create parse errors
//
//newErrorUnknown :: SourcePos -> ParseError
//newErrorUnknown pos
//    = ParseError pos []
function newErrorUnknown(pos){
    return ParseError.ParseError(pos, []);
}

//newErrorMessage :: Message -> SourcePos -> ParseError
//newErrorMessage msg pos
//    = ParseError pos [msg]
function newErrorMessage(msg, pos){
    return ParseError.ParseError(pos, [msg]);
}

//addErrorMessage :: Message -> ParseError -> ParseError
//addErrorMessage msg (ParseError pos msgs)
//    = ParseError pos (msg:msgs)
function addErrorMessage(msg, parseError){
    return ParseError.ParseError(parseError[0], cons(msg, parseError[1]));
}

//setErrorPos :: SourcePos -> ParseError -> ParseError
//setErrorPos pos (ParseError _ msgs)
//    = ParseError pos msgs
function setErrorPos(pos, parseError) {
    return ParseError.ParseError(pos, parseError[1]);
}

//setErrorMessage :: Message -> ParseError -> ParseError
//setErrorMessage msg (ParseError pos msgs)
//    = ParseError pos (msg : filter (msg /=) msgs)
function setErrorMessage(msg, parseError) {
    return ParseError.ParseError(parseError[0], cons(msg, filter(curry(Eq.ne)(msg), parseError[1])));
}

//mergeError :: ParseError -> ParseError -> ParseError
//mergeError (ParseError pos msgs1) (ParseError _ msgs2)
//    = ParseError pos (msgs1 ++ msgs2)
function mergeError(parseError1, parseError2){
    return ParseError.ParseError(parseError1[0], append(parseError1[1], parseError2[1]));
}

//instance Show ParseError where
//    show err
//        = show (errorPos err) ++ ":" ++
//          showErrorMessages "or" "unknown parse error"
//                            "expecting" "unexpected" "end of input"
//                           (errorMessages err)
instance(Show, ParseError)
    ("show", function(err){
        return Show.show(errorPos(err)) + ":" +
               showErrorMessages("or", "unknown parse error",
                                 "expecting", "unexpected", "end of input",
                                 errorMessages(err));
    })

//-- Language independent show function
//
//--  TODO
//-- < The standard function for showing error messages. Formats a list of
//--    error messages in English. This function is used in the |Show|
//--    instance of |ParseError <#ParseError>|. The resulting string will be
//--    formatted like:
//--
//--    |unexpected /{The first UnExpect or a SysUnExpect message}/;
//--    expecting /{comma separated list of Expect messages}/;
//--    /{comma separated list of Message messages}/
//
//showErrorMessages ::
//    String -> String -> String -> String -> String -> [Message] -> String
//showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs
function showErrorMessages(msgOr, msgUnknown, msgExpecting, msgUnExpected, msgEndOfInput, msgs){
//      (sysUnExpect,msgs1) = span ((SysUnExpect "") ==) msgs
    var tmp1 = span(curry(Eq.eq)(Message.SysUnExpect("")), msgs),
        sysUnExpect = tmp1[0],
        msgs1 = tmp1[1];
    
//      (unExpect,msgs2)    = span ((UnExpect    "") ==) msgs1
    var tmp2 = span(curry(Eq.eq)(Message.UnExpect("")), msgs1),
        unExpect = tmp2[0],
        msgs2 = tmp2[1];

//      (expect,messages)   = span ((Expect      "") ==) msgs2
    var tmp3 = span(curry(Eq.eq)(Message.Expect("")), msgs2),
        expect = tmp3[0],
        messages = tmp3[1];

//      firstMsg  = messageString (head sysUnExpect)
    var firstMsg  = messageString(head(sysUnExpect));

//      showMany pre msgs = case clean (map messageString msgs) of
//                            [] -> ""
//                            ms | null pre  -> commasOr ms
//                               | otherwise -> pre ++ " " ++ commasOr ms
    function showMany(pre, msgs){
        var res = clean(map(messageString, msgs));
        return (!res.length) ? "" :
                null_(pre) ? commasOr(ms) :
                append(append(pre, " "), commasOr(ms));
    }
    
//      showExpect      = showMany msgExpecting expect
    var showExpect      = showMany(msgExpecting, expect);

//      showUnExpect    = showMany msgUnExpected unExpect
    var showUnExpect    = showMany(msgUnExpected, unExpect);

//      showSysUnExpect | not (null unExpect) ||
//                        null sysUnExpect = ""
//                      | null firstMsg    = msgUnExpected ++ " " ++ msgEndOfInput
//                      | otherwise        = msgUnExpected ++ " " ++ firstMsg
    var showSysUnExpect =
            (not(null_(unExpect)) || null_(sysUnExpect)) ? "" :
            null_(firstMsg) ? append(append(msgUnExpected, " "), msgEndOfInput) :
                              append(append(msgUnExpected, " "), firstMsg);
    
//      showMessages      = showMany "" messages
    var showMessages      = showMany("", messages)

//      commasOr []       = ""
//      commasOr [m]      = m
//      commasOr ms       = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms
    function commasOr(ms){
        return (!ms.length) ? "" :
               (ms.length == 1) ? ms[0] :
               foldl(append, commaSep(init(ms)), [" ", msgOr, " ", last(ms)]);
    }
    
//      seperate   _ []     = ""
//      seperate   _ [m]    = m
//      seperate sep (m:ms) = m ++ sep ++ seperate sep ms
    function seperate(sep, ms){
        return (!ms.length) ? "" :
               (ms.length == 1) ? ms[0] :
               append(append(ms[0], sep), seperate(sep, ms));
    }

//      clean             = nub . filter (not . null)
    var clean = ex(nub ,'.', filter, [not ,'.', null_]).resolve();
    
//      commaSep          = seperate ", " . clean
    var commaSep          = compose1(curry(seperate)(", "), clean);
   

//    | null msgs = msgUnknown
//    | otherwise = concat $ map ("\n"++) $ clean $
//                 [showSysUnExpect,showUnExpect,showExpect,showMessages]
    if(null_(msgs))
        return msgUnknown;
    else
        return ex(concat ,"$", curry(map)(curry(append)("\n")) ,"$", clean ,"$",
                nop([showSysUnExpect,showUnExpect,showExpect,showMessages])).resolve();
}